home *** CD-ROM | disk | FTP | other *** search
/ Info-Mac 3 / Info_Mac_1994-01.iso / Development / General / XLisp 2.1e3 / Sources / macfun.c < prev    next >
Text File  |  1993-09-18  |  6KB  |  225 lines
  1. /* macfun.c - macintosh user interface functions for xlisp */
  2. /* Written by Brian Kendig. */
  3.  
  4. #include <Quickdraw.h>
  5. #include <Windows.h>
  6. #include <Memory.h>
  7. #include "xlisp.h"
  8.  
  9. /* externals */
  10. extern GrafPtr commandWin, graphicsWin;
  11. extern Boolean hasColorQD;
  12. extern unsigned long startupTicks;
  13. extern void ShowGrafWin (void);
  14. extern void HideGrafWin (void);
  15. extern void MacWrapUp (void);
  16.  
  17. LVAL xrealtime (void)    { return cvfixnum ((FIXTYPE)real_tick_count()); }    /* get-internal-real-time */
  18. LVAL xruntime (void)    { return cvfixnum ((FIXTYPE)run_tick_count()); }    /* get-internal-run-time */
  19. LVAL xtime (void)        { return cvfixnum ((FIXTYPE)real_tick_count()); }    /* time */
  20.  
  21. unsigned long ticks_per_second (void)    { return 60; }
  22. unsigned long run_tick_count (void)        { return ((unsigned long) TickCount ()) - startupTicks; }
  23. unsigned long real_tick_count (void)    { return (unsigned long) TickCount (); }
  24.  
  25. /* get an integer parameter */
  26. LOCAL int getNumber () {
  27.     LVAL num = xlgafixnum ();
  28.     return ((int) getfixnum (num));
  29. }
  30.  
  31. /* handle commands that require integer arguments */
  32. LOCAL LVAL GrafCmd (char funct, int nArgs) {
  33.     short x, y, z;
  34.     if (nArgs > 0) x = getNumber ();
  35.     if (nArgs > 1) y = getNumber ();
  36.     if (nArgs > 2) z = getNumber ();
  37.     xllastarg ();
  38.     SetPort (graphicsWin);
  39.     switch (funct) {
  40.     case 'G': ShowGrafWin ();    break;
  41.     case 'g': HideGrafWin ();    break;
  42.     case 'x': EraseRect (&graphicsWin->portRect);    break;
  43.     case 's': ShowPen ();        break;
  44.     case 'h': HidePen ();        break;
  45.     case 'd': PenMode (x);        break;
  46.     case 'M': Move (x, y);        break;
  47.     case 'm': MoveTo (x, y);    break;
  48.     case 'L': Line (x, y);        break;
  49.     case 'l': LineTo (x, y);    break;
  50.     case 'S': PenSize (x, y);    break;
  51.     case 'p': PenNormal ();        break;
  52.     case 'c':
  53.         if (hasColorQD) {
  54.             RGBColor col;  col.red = x;  col.green = y;  col.blue = z;
  55.             RGBForeColor (&col);
  56.         } break;
  57.     }
  58.     SetPort (commandWin);
  59.     return NIL;
  60. }
  61.  
  62. LVAL xshowgraphics (void)    { return GrafCmd ('G', 0); }  /* show graphics win */
  63. LVAL xhidegraphics (void)    { return GrafCmd ('g', 0); }  /* hide graphics win */
  64. LVAL xcleargraphics (void)    { return GrafCmd ('x', 0); }  /* clear graphics win */
  65. LVAL xshowpen (void)    { return GrafCmd ('s', 0); }  /* show the pen */
  66. LVAL xhidepen (void)    { return GrafCmd ('h', 0); }  /* hide the pen */
  67. LVAL xpenmode (void)    { return GrafCmd ('d', 1); }  /* set the pen mode */
  68. LVAL xmove (void)        { return GrafCmd ('M', 2); }  /* move pen in a specified direction */
  69. LVAL xmoveto (void)        { return GrafCmd ('m', 2); }  /* move pen to a screen location */
  70. LVAL xdraw (void)        { return GrafCmd ('L', 2); }  /* draw a line in a specified direction */
  71. LVAL xdrawto (void)        { return GrafCmd ('l', 2); }  /* draw a line to a screen location */
  72. LVAL xpensize (void)    { return GrafCmd ('S', 2); }  /* set the pen size */
  73. LVAL xpennormal (void)    { return GrafCmd ('p', 0); }  /* set the pen to normal */
  74. LVAL xcolor (void)        { return GrafCmd ('c', 3); }  /* set RGB color of pen */
  75.  
  76.  
  77. LVAL xgetpen (void) {  /* get the pen position */
  78.     LVAL val;
  79.     Point p;
  80.     xllastarg ();
  81.     SetPort ((GrafPtr)graphicsWin);
  82.     GetPen (&p);
  83.     SetPort (commandWin);
  84.     xlsave1 (val);
  85.     val = consa (NIL);
  86.     rplaca (val,cvfixnum ((FIXTYPE)p.h));
  87.     rplacd (val,cvfixnum ((FIXTYPE)p.v));
  88.     xlpop ();
  89.     return val;
  90. }
  91.  
  92. LVAL xpenpat (void) {  /* set the pen pattern */
  93.     LVAL plist;
  94.     Pattern pat;
  95.     int i;
  96.     plist = xlgalist ();
  97.     xllastarg ();
  98.     for (i = 0; i < 8 && consp (plist); ++i, plist = cdr (plist))
  99.     if (fixp (car (plist))) pat[i] = getfixnum (car (plist));
  100.     SetPort ((GrafPtr)graphicsWin);
  101.     PenPat (pat);
  102.     SetPort (commandWin);
  103.     return NIL;
  104. }
  105.  
  106.  
  107. /* The functions below are not yet implemented. */
  108.  
  109. LVAL xtool (void) {  /* call the toolbox */
  110.     int trap = getNumber ();
  111.     LVAL val;
  112.  
  113. /*    asm {
  114.         move.l    args(A6),D0
  115.         beq    L2
  116.     L1:    move.l    D0,A0
  117.         move.l    2(A0),A1
  118.         move.w    4(A1),-(A7)
  119.         move.l    6(A0),D0
  120.         bne    L1
  121.     L2:    lea    L3,A0
  122.         move.w    trap(A6),(A0)
  123.     L3:    dc.w    0xA000
  124.         clr.l    val(A6)
  125.     }
  126.  
  127.     return val; */
  128.     return cvfixnum ((FIXTYPE) trap);
  129. }
  130.  
  131. LVAL xtool16 (void) {  /* call the toolbox with a 16 bit result */
  132.     int trap = getNumber ();
  133.     int val;
  134.  
  135. /*    asm {
  136.         clr.w    -(A7)
  137.         move.l    args(A6), D0
  138.         beq        L2
  139.     L1:    move.l    D0, A0
  140.         move.l    2(A0), A1
  141.         move.w    4(A1), -(A7)
  142.         move.l    6(A0), D0
  143.         bne        L1
  144.     L2:    lea        L3, A0
  145.         move.w    trap(A6), (A0)
  146.     L3:    dc.w    0xA000
  147.         move.w    (A7)+, val(A6)
  148.     }
  149.  
  150.     return cvfixnum ((FIXTYPE) val); */
  151.     return cvfixnum ((FIXTYPE) trap);
  152. }
  153.  
  154. LVAL xtool32 (void) {  /* call the toolbox with a 32 bit result */
  155.     int trap = getNumber ();
  156.     long val;
  157.  
  158. /*    asm {
  159.         clr.l    -(A7)
  160.         move.l    args(A6),D0
  161.         beq    L2
  162.     L1:    move.l    D0,A0
  163.         move.l    2(A0),A1
  164.         move.w    4(A1),-(A7)
  165.         move.l    6(A0),D0
  166.         bne    L1
  167.     L2:    lea    L3,A0
  168.         move.w    trap(A6),(A0)
  169.     L3:    dc.w    0xA000
  170.         move.l    (A7)+,val(A6)
  171.     }
  172.  
  173.     return cvfixnum ((FIXTYPE) val); */
  174.     return cvfixnum ((FIXTYPE) trap);
  175. }
  176.  
  177. LVAL xnewhandle (void) {  /* allocate a new handle */
  178.     LVAL num = xlgafixnum ();
  179.     long size = getfixnum (num);
  180.     xllastarg ();
  181.     return cvfixnum ((FIXTYPE) NewHandle (size));
  182. }
  183.  
  184. LVAL xnewptr (void) {  /* allocate memory */
  185.     LVAL num = xlgafixnum ();
  186.     long size = getfixnum (num);
  187.     xllastarg ();
  188.     return cvfixnum ((FIXTYPE) NewPtr (size));
  189. }
  190.  
  191. LVAL xhiword (void) {  /* return the high order 16 bits of an integer */
  192.     unsigned int val = (unsigned int) (getNumber () >> 16);
  193.     xllastarg ();
  194.     return cvfixnum ((FIXTYPE) val);
  195. }
  196.  
  197. LVAL xloword (void) {  /* return the low order 16 bits of an integer */
  198.     unsigned int val = (unsigned int) getNumber ();
  199.     xllastarg ();
  200.     return cvfixnum ((FIXTYPE) val);
  201. }
  202.  
  203. LVAL xrdnohang (void) {  /* get the next character in the look-ahead buffer */
  204.     int ch = 0;
  205.     xllastarg ();
  206. /*    if ((ch = scrnextc ()) == EOF) return NIL; */
  207.     return cvfixnum ((FIXTYPE) ch);
  208. }
  209.  
  210. void ossymbols (void) {  /* ossymbols - enter important symbols */
  211.     LVAL sym;
  212.  
  213.     /* setup globals for the window handles */
  214.     sym = xlenter ("*COMMAND-WINDOW*");
  215.     setvalue (sym, cvfixnum ((FIXTYPE) commandWin));
  216.     sym = xlenter ("*GRAPHICS-WINDOW*");
  217.     setvalue (sym, cvfixnum ((FIXTYPE) graphicsWin));
  218. }
  219.  
  220. void xoserror (char *msg) { /* do nothing */ }
  221.  
  222. LVAL xsystem (V) { return NIL; }
  223. LVAL xgetkey (V) { return NIL; }
  224.  
  225.